home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / pc_board / cyb02pdc.zip / PDC.PRG < prev   
Text File  |  1992-07-23  |  4KB  |  175 lines
  1. set echo off
  2. set talk on
  3. clear all
  4. close all
  5. clear
  6.  
  7. *  pcbdir : FoxPro DBF, step 1. PCBoard directory is read in as an SDF file.
  8. *  foxdir : FoxPro DBF, step 2. Final form, contains descriptions as memos.
  9. * pcboard : PCBoard directory. I'll likely be using this to match file
  10. *           descriptions to floppy archive entries, so for me NEW is most
  11. *           appropriate.
  12.  
  13. store "pcbdir" to pcbdir
  14. store "foxdir" to foxdir
  15. store "new."   to pcboard
  16.  
  17. select 2
  18. use &foxdir
  19. dele all
  20. pack
  21.  
  22. select 1
  23. use &pcbdir
  24. dele all
  25. pack
  26. append from &pcboard type sdf
  27.  
  28. set talk off
  29. clear
  30.  
  31. @ 0,0 say " CYBERPDC 2.00113ß (c) Copyright <<> westsmith 92/7/23"
  32.  
  33. define window upper from  1,0 to 12,79
  34. define window lower from 13,0 to 24,79
  35. activ window upper
  36. activ window lower
  37.  
  38. set memowidth to 45
  39.  
  40. locked=.f.
  41. spec=""
  42. xspec=""
  43. xdesc=""
  44. xuploader=""
  45. z1=""
  46.  
  47. goto top
  48. do while not eof()
  49.    spec=file+subst(str(size),3)+date+"  "
  50.    status=0
  51.    if locked then
  52.       status=1
  53.    else
  54.       status=0
  55.    endif
  56.    if ("-"=subst(date,5,1)) and ("-"=subst(date,8,1)) then
  57.       if not ""=ltrim(file) then
  58.          status=status+10
  59.       endif
  60.    endif
  61.    special=0
  62.    if "UPLOADED BY: "=upper(left(desc,13)) then
  63.       special=1
  64.       xuploader=subst(desc,14)
  65.    endif
  66.    do case
  67.       case special=1
  68.       otherwise
  69.          do case
  70.             case status=0
  71.                * looking for a file, line is not a file starter
  72.             case status=1
  73.                * reading description for a file, line is not a file starter
  74.                xdesc=rtrim(xdesc)+" "+rtrim(desc)
  75.             case status=10
  76.                * looking for a file, line contains file info
  77.                locked=.t.
  78.                do newfile
  79.                xspec=spec
  80.                xdesc=&pcbdir->desc
  81.             case status=11
  82.                * reading description for a file, line contains file info      
  83.                do crush
  84.                do newfile
  85.                xspec=spec
  86.                xdesc=&pcbdir->desc
  87.             otherwise
  88.          endcase
  89.          if locked
  90.             if (""=ltrim(file)) then
  91.                do hurl with 1, repl(" ",31)+"| "+desc
  92.             else
  93.                do hurl with 1, spec+desc
  94.             endif
  95.          endif
  96.    endcase
  97.    skip
  98. enddo
  99. if locked then
  100.    do crush
  101. endif
  102. deac wind all
  103. close all
  104. return
  105.  
  106. procedure hurl
  107. param z, y
  108. * z : which window to use
  109. * y : string to print
  110. * --------------------------------------------------------------------------
  111.    if z=1 then
  112.       activ window upper
  113.    else
  114.       activ window lower
  115.    endif
  116.    ?? left(y+repl(" ",78),78)
  117. return
  118.  
  119. procedure repl
  120. param z,y,x
  121. * z : string
  122. * y : string to replace
  123. * x : string to replace with
  124. * --------------------------------------------------------------------------
  125.    w=at(y,z)
  126.    do while w>0
  127.        z=left(z,w-1)+x+subst(z,w+len(y))
  128.       w=at(y,z)
  129.    enddo
  130. return
  131.  
  132. procedure newfile
  133. * no parameters
  134. * --------------------------------------------------------------------------
  135.    select 2
  136.    append blank
  137.    repl name with left(&pcbdir->file,at(".",&pcbdir->file+".")-1)
  138.    repl ext with subst(&pcbdir->file,at(".",&pcbdir->file+".")+1)
  139.    repl size with &pcbdir->size
  140.    repl date with ctod(ltrim(&pcbdir->date))
  141.    select 1
  142. return
  143.  
  144. procedure crush
  145. * no parameters
  146. * --------------------------------------------------------------------------
  147.    xdesc=xdesc+" "
  148.    do repl with xdesc,"  "," "
  149.    first=left(xdesc,46)
  150.    do while (" "<>right(first,1)) and (len(first)>0)
  151.       first=left(first,len(first)-1)
  152.    enddo
  153.    if ""=first then
  154.       first=left(xdesc,45)
  155.    endif
  156.    do hurl with 2,xspec+first
  157.    remains=ltrim(subst(xdesc,len(first)+1))
  158.    do while len(remains)>0
  159.       another=left(remains,46)
  160.       do while (" "<>right(another,1)) and (len(another)>0)
  161.          another=left(another,len(another)-1)
  162.       enddo
  163.       if ""=another then
  164.          another=left(remains,45)
  165.       endif
  166.       do hurl with 2, repl(" ",31)+"| "+another
  167.       remains=ltrim(subst(remains,len(another)+1))
  168.    enddo
  169.    select 2
  170.    repl desc with xdesc
  171.    repl uploader with xuploader
  172.    xuploader=""
  173.    select 1
  174. return
  175.